home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.003 / stk-3 / stk / 3.1 / STk / Entry.stklos < prev    next >
Encoding:
Text File  |  1996-07-29  |  4.4 KB  |  162 lines
  1. ;;;;
  2. ;;;; E n t r y . s t k         --  Entry class definition
  3. ;;;;
  4. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@unice.fr]
  15. ;;;;    Creation date: 28-Feb-1994 11:36
  16. ;;;; Last file update:  8-Jul-1996 00:12
  17.  
  18. (require "Basics")
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. ;;;;
  22. ;;;; <Entry> class
  23. ;;;;
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (define-class <Entry> (<Tk-simple-widget> <Tk-editable> <Tk-selectable> 
  27.                <Tk-text-selectable>)
  28.   ((justify         :accessor     justify
  29.              :init-keyword :justify
  30.              :allocation   :tk-virtual)
  31.    (x-scroll-command :init-keyword :x-scroll-command
  32.              :accessor     x-scroll-command
  33.              :tk-name      xscrollcommand
  34.              :allocation   :tk-virtual)
  35.    (text-variable    :accessor     text-variable
  36.              :init-keyword :text-variable
  37.              :allocation   :tk-virtual
  38.              :tk-name      textvar)
  39.    (show-chars         :accessor       show-chars
  40.              :init-keyword :show-chars
  41.              :allocation   :tk-virtual
  42.              :tk-name       show)
  43.    (state         :accessor     state
  44.              :init-keyword :state
  45.              :allocation   :tk-virtual)
  46.    (string-value     :accessor     string-value
  47.              :init-keyword :string-value
  48.              :tk-name      stringval
  49.              :allocation   :tk-virtual)
  50.    (width         :accessor     width
  51.              :init-keyword :width 
  52.              :allocation   :tk-virtual)
  53.    ;; Fictive slot 
  54.    (value              :accessor     value
  55.                    :init-keyword :value
  56.                    :allocation   :virtual
  57.                  :slot-ref     (lambda (o)  
  58.                      ((slot-ref o 'Id) 'get))
  59.                  :slot-set!    (lambda (o v) 
  60.                      ;; First delete all present chars
  61.                      ((slot-ref o 'Id) 'delete 0 'end)
  62.                      ;; Then insert new text
  63.                      ((slot-ref o 'Id) 'insert 0 v)))))
  64.  
  65. (define-method tk-constructor ((self <Entry>))
  66.   Tk:entry)
  67.  
  68. ;;;
  69. ;;; bounding-box
  70. ;;;
  71. (define-method bounding-box ((self <Entry>) index)
  72.   ((slot-ref self 'Id) 'bbox index))
  73.  
  74. ;;;
  75. ;;; Delete
  76. ;;; 
  77. (define-method text-delete ((self <Entry>) start)
  78.   ((slot-ref self 'Id) 'delete start))
  79.  
  80. (define-method text-delete ((self <Entry>) start end)
  81.   ((slot-ref self 'Id) 'delete start end))
  82.  
  83.  
  84. ;;;
  85. ;;; Cursor and (setter Cursor)
  86. ;;;
  87. (define-method text-cursor ((self <Entry>))
  88.   ((slot-ref self 'Id) 'index 'insert))
  89.  
  90. (define-method (setter text-cursor) ((self <Entry>) index)
  91.   ((slot-ref self 'Id) 'icursor index))
  92.  
  93. ;;;
  94. ;;; Index 
  95. ;;;
  96. (define-method text-index ((self <Entry>) index)
  97.   ((slot-ref self 'Id) 'index index))
  98.  
  99. ;;;
  100. ;;; Insert
  101. ;;;
  102. (define-method text-insert ((self <Entry>) text)
  103.   ((slot-ref self 'Id) 'insert 'insert text))
  104.  
  105. (define-method text-insert ((self <Entry>) text position)
  106.   (let ((entry (slot-ref self 'Id)))
  107.     (entry 'icursor (car position))
  108.     (entry 'insert 'insert text)))
  109.  
  110. ;;;
  111. ;;; Mark 
  112. ;;; 
  113. (define-method text-mark ((self <Entry>) pos)
  114.   ((slot-ref self 'Id) 'scan 'mark pos))
  115.  
  116. ;;;
  117. ;;; Drag-to 
  118. ;;; 
  119. (define-method text-drag-to ((self <Entry>) pos)
  120.   ((slot-ref self 'Id) 'scan 'dragto pos))
  121.  
  122. ;;;
  123. ;;; Selection-anchor
  124. ;;; 
  125. (define-method selection-adjust ((self <Entry>) index)
  126.   ((slot-ref self 'Id) 'selection 'adjust index))
  127.  
  128. ;;;
  129. ;;; Selection-clear
  130. ;;; 
  131. (define-method selection-clear ((self <Entry>))
  132.   (apply (slot-ref self 'Id) 'selection 'clear))
  133.  
  134. ;;;
  135. ;;; Selection-present?
  136. ;;; 
  137. (define-method selection-present? ((self <Entry>))
  138.   ((slot-ref self 'Id) 'selection 'present))
  139.  
  140. ;;;
  141. ;;; Selection-set!
  142. ;;; 
  143. (define-method selection-set! ((self <Entry>) first  last)
  144.   (let ((Id (slot-ref self 'Id)))
  145.     (Id 'selection 'clear)
  146.     (Id 'selection 'from first)
  147.     (Id 'selection 'to last)))
  148.  
  149. ;;;
  150. ;;; Selection-to!
  151. ;;; 
  152. (define-method selection-to! ((self <Entry>) index)
  153.   ((slot-ref self 'Id) 'selection 'set index))
  154.  
  155. ;;;
  156. ;;; X-view
  157. ;;; 
  158. (define-method text-x-view ((self <Entry>) . args)
  159.   (apply (slot-ref self 'Id) 'xview args))
  160.  
  161. (provide "Entry")
  162.